-- Experimental Thinder Compiler

module Main where
import qualified LPParser as Parser
import System(getArgs)

main = do
    args <- getArgs
    if ((length args) /= 3) 
       then (error "Expecting 3 filenames!\nlp <input.lpt> <lexer.ux> <outputlexer.x>") 
       else putStr "Building token parser... "
    input <- readFile (args!!0)
    lexer <- readFile (args!!1)
    writeFile (args!!2) (buildLexer lexer (Parser.parse (Parser.lexer input)))
    putStrLn "Done."
    
replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace [] _ _ = []
replace s find repl =
    if take (length find) s == find
        then repl ++ (replace (drop (length find) s) find repl)
        else [head s] ++ (replace (tail s) find repl)    
    
buildLexer :: String -> [Parser.Rule] -> String
buildLexer s rules = doPosn $ doGetValue $ doKeywords $ doData $ doTokens ("{\n-- THIS IS AN AUTOMATICALLY GENERATED FILE\n-- ALL CHANGES WILL BE LOST!\n\n" ++ (tail s))
        where doTokens t = replace t "$(TOKENS)" (fetchTokens rules "\n")
              doData t = replace t "$(DATA)" (fetchData rules "")
              doKeywords t = replace t "$(KEYWORDS)" (fetchKeywords rules "\n")
              doGetValue t = replace t "$(GETVALUE)" (fetchGetValue rules "\n")
              doPosn t = replace t "$(POSN)" (fetchPosn rules "\n")

-- TODO: find identation
        
fetchTokens :: [Parser.Rule] -> String -> String
fetchTokens ((Parser.RuleChar char token):xs) s = fetchTokens xs (s ++ "  \"" ++ char ++ "\" { " ++ token ++ " }\n")
fetchTokens (_:xs) s = fetchTokens xs s
fetchTokens [] s = s

fetchData ::[Parser.Rule] -> String -> String
fetchData ((Parser.RuleChar _ token):xs) s = fetchData xs (s ++ "| " ++ token ++ " AlexPosn String ")
fetchData ((Parser.RuleToken token theType _):xs) s = fetchData xs (s ++ "| " ++ token ++ " AlexPosn " ++ theType ++ " ")
fetchData (_:xs) s = fetchData xs s
fetchData [] s = s

fetchKeywords ::[Parser.Rule] -> String -> String
fetchKeywords ((Parser.RuleKeyword name token value):xs) s = fetchKeywords xs (s ++ "                    | s == \"" ++ name ++ "\" = " ++ token ++ " p " ++ value ++ "\n")
fetchKeywords (_:xs) s = fetchKeywords xs s
fetchKeywords [] s = s

fetchGetValue ::[Parser.Rule] -> String -> String
fetchGetValue ((Parser.RuleChar _ token):xs) s = fetchGetValue xs (s ++ "tokenGetValue (" ++ token ++ " _ s) = s\n")
fetchGetValue ((Parser.RuleToken token _ toString):xs) s = fetchGetValue xs (s ++ "tokenGetValue (" ++ token ++ " _ s) = " ++ toString ++ " s\n")
fetchGetValue (_:xs) s = fetchGetValue xs s
fetchGetValue [] s = s

fetchPosn ::[Parser.Rule] -> String -> String
fetchPosn ((Parser.RuleChar _ token):xs) s = fetchPosn xs (s ++ "tokenPosn (" ++ token ++ " p _) = p\n")
fetchPosn ((Parser.RuleToken token _ _):xs) s = fetchPosn xs (s ++ "tokenPosn (" ++ token ++ " p _) = p\n")
fetchPosn (_:xs) s = fetchPosn xs s
fetchPosn [] s = s


